home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tool-inc.zip / PLOTLIB.INC < prev    next >
Text File  |  1990-01-31  |  11KB  |  442 lines

  1.  
  2. (*
  3.  * plotlib - graphics graph plotting package
  4.  *
  5.  *)
  6.  
  7.  
  8. (* ------------------------------------------------------------------- *)
  9. {translate logical x location into physical pixel location}
  10.  
  11. function get_phys_x(vx: real): integer;
  12. var x: real;
  13. begin
  14.    if (vx > maxx) then
  15.       vx := maxx;
  16.    if (vx < minx) then
  17.       vx := minx;
  18.  
  19.    x := (phys_maxx - phys_minx) * (vx - minx) / (maxx - minx) + phys_minx;
  20.    get_phys_x := trunc(x);
  21. end;
  22.  
  23.  
  24.  
  25. {translate logical y location into physical pixel location}
  26.  
  27. function get_phys_y(vy: real): integer;
  28. var y: real;
  29. begin
  30.    if (vy > maxy) then
  31.       vy := maxy;
  32.    if (vy < miny) then
  33.       vy := miny;
  34.  
  35.    y := (phys_maxy - phys_miny) * (vy - miny) / (maxy - miny) + phys_miny;
  36.    get_phys_y := trunc(y);
  37. end;
  38.  
  39.  
  40. (* ------------------------------------------------------------------- *)
  41. procedure draw(x1,y1,x2,y2,color: integer);
  42. begin
  43.    SetColor(color);
  44.    Line(x1,y1,x2,y2);
  45. end;
  46.  
  47. procedure plot(x1,y1,color: integer);
  48. begin
  49.    SetColor(color);
  50.    PutPixel(x1,y1,$FFFF);
  51. end;
  52.  
  53.  
  54.  
  55. (* ------------------------------------------------------------------- *)
  56. {connect two logical points with a line}
  57.  
  58. procedure connect(x1,y1,x2,y2: real);
  59. var
  60.   px1,py1,px2,py2: integer;
  61. begin
  62.    px1 := get_phys_x(x1);
  63.    if x2 <> x1 then
  64.       px2 := get_phys_x(x2)
  65.    else
  66.       px2 := px1;
  67.  
  68.    py1 := get_phys_y(y1);
  69.    if y2 <> y1 then
  70.       py2 := get_phys_y(y2)
  71.    else
  72.       py2 := py1;
  73.  
  74.    if (px1 <> px2) or (py1 <> py2) then
  75.       draw(px1,py1,px2,py2,color)
  76.    else
  77.       plot(px1,py1,color);
  78. end;
  79.  
  80.  
  81.  
  82. {place a tick mark on a point}
  83.  
  84. procedure tick(x1,y1: real);
  85. begin
  86.    plot(get_phys_x(x1),get_phys_y(y1),color);
  87. end;
  88.  
  89.  
  90.  
  91. (* ------------------------------------------------------------------- *)
  92. {determine a nice looking scale}
  93.  
  94. procedure determinescale (var world_min:     real;
  95.                           var world_max:     real;
  96.                           var stepsz:        real;
  97.                           var stepcnt:       integer;
  98.                               maxstep:       integer);
  99.       var
  100.          new_min:          real;
  101.          new_max:          real;
  102.          damper:           integer;
  103.          pct:              real;
  104.          range:            real;
  105.          curstep:          integer;
  106.          w:                real;
  107.  
  108.       const
  109.          limit  =  32000;   {maximum number of iterations to determine
  110.                              the new scale boundries}
  111.  
  112.  
  113. (* return next higher stepsize multiplier *)
  114.       function nextstep: real;
  115.       begin
  116.          case curstep of
  117.             1:  nextstep := 2;    {2}
  118.             2:  nextstep := 2.5;  {5}
  119.             3:  nextstep := 2;    {10}
  120.          end;
  121.  
  122.          curstep := curstep + 1;
  123.          if curstep > 3 then
  124.             curstep := 1;
  125.       end;
  126.  
  127.  
  128.  
  129. (* return number of steps with current stepsz *)
  130.       function nsteps: integer;
  131.          var
  132.             n:  real;
  133.  
  134.          begin
  135.             if stepsz = 0.0 then
  136.                n := 0.0
  137.             else
  138.                n := (new_max - new_min)/ stepsz + 1.5;
  139.  
  140.             if n < 0.0 then
  141.                n := 0.0;
  142.  
  143.             if n >= maxint then
  144.                n := maxint-1.0;
  145.  
  146.             nsteps := trunc (n);
  147.          end;
  148.  
  149.  
  150.    begin                         {determine proper step size}
  151.  
  152. (* find best step size *)
  153.  
  154.       new_min := world_min;
  155.       new_max := world_max;
  156.       curstep := 1;
  157.       stepsz := 1;
  158.  
  159.       while (nsteps < maxstep) and (nsteps > 0) do
  160.             stepsz := stepsz / 10.0;
  161.  
  162.       while (nsteps > maxstep) and (nsteps > 0) do
  163.             stepsz := stepsz * nextstep;
  164.  
  165.  
  166. (*
  167.  * note - this process will take forever if you have a very narrow
  168.  *        range that is sitting on a huge offset.  the damper variable
  169.  *        will cause this routine to give up after limit iterations
  170.  *        if it has not found the endpoints
  171.  *)
  172.       damper := 0;
  173.       repeat
  174.  
  175.          new_min := 0.0;   {determine even endpoints based on stepsz}
  176.          new_max := 0.0;
  177.  
  178.          if stepsz <> 0.0 then
  179.          begin
  180.             while (new_min <= world_min) and (damper < limit) do
  181.             begin
  182.                damper := damper + 1;
  183.                new_min := new_min + abs(stepsz)*200.0;
  184.             end;
  185.  
  186.             w := world_min;
  187.             while (new_min > w) and (damper < limit) do
  188.             begin
  189.                damper := damper + 1;
  190.                new_min := new_min - abs(stepsz);
  191.             end;
  192.  
  193.             new_max := new_min;
  194.             while (new_max >= world_max) and (damper < limit) do
  195.             begin
  196.                damper := damper + 1;
  197.                new_max := new_max - abs(stepsz);
  198.             end;
  199.  
  200.             w := world_max;
  201.             while (new_max < w) and (damper < limit) do
  202.             begin
  203.                damper := damper + 1;
  204.                new_max := new_max + abs(stepsz);
  205.             end;
  206.          end;
  207.  
  208. (* if new min/max causes extra steps, then go to a larger step size
  209.    and try again *)
  210.          stepcnt := nsteps;
  211.  
  212.          if stepcnt > maxstep then
  213.             stepsz := stepsz * nextstep;
  214.  
  215.       until stepcnt <= maxstep;
  216.  
  217.       world_min := new_min;  {assign final return values}
  218.       world_max := new_max;
  219.    end;                       {PLOT_set_scale}
  220.  
  221.  
  222.  
  223. (* ------------------------------------------------------------------- *)
  224. {place a marker at a logical point}
  225.  
  226. procedure marker(x,y: real; style: integer);
  227. begin
  228.  
  229.    case style of
  230.    1: begin     {place an X on the point}
  231.           draw(get_phys_x(x)-mark_x,get_phys_y(y)-mark_y,
  232.                get_phys_x(x)+mark_x,get_phys_y(y)+mark_y,yellow);
  233.           draw(get_phys_x(x)-mark_x,get_phys_y(y)+mark_y,
  234.                get_phys_x(x)+mark_x,get_phys_y(y)-mark_y,yellow);
  235.        end;
  236.  
  237.    2: begin     {place an box around the point}
  238.           draw(get_phys_x(x)-mark_x,get_phys_y(y)-mark_y,
  239.                get_phys_x(x)-mark_x,get_phys_y(y)+mark_y,yellow);
  240.           draw(get_phys_x(x)+mark_x,get_phys_y(y)-mark_y,
  241.                get_phys_x(x)+mark_x,get_phys_y(y)+mark_y,yellow);
  242.           draw(get_phys_x(x)-mark_x,get_phys_y(y)+mark_y,
  243.                get_phys_x(x)+mark_x,get_phys_y(y)+mark_y,yellow);
  244.           draw(get_phys_x(x)-mark_x,get_phys_y(y)-mark_y,
  245.                get_phys_x(x)+mark_x,get_phys_y(y)-mark_y,yellow);
  246.        end;
  247.  
  248.    3: begin     {place a triangle on the point}
  249.           draw(get_phys_x(x)-mark_x,get_phys_y(y)+mark_y,
  250.                get_phys_x(x)       ,get_phys_y(y)-mark_y,yellow);
  251.           draw(get_phys_x(x)+mark_x,get_phys_y(y)+mark_y,
  252.                get_phys_x(x)       ,get_phys_y(y)-mark_y,yellow);
  253.           draw(get_phys_x(x)+mark_x,get_phys_y(y)+mark_y,
  254.                get_phys_x(x)-mark_x,get_phys_y(y)+mark_y,yellow);
  255.        end;
  256.  
  257.    4: begin     {place an inverted triangle on the point}
  258.           draw(get_phys_x(x)-mark_x,get_phys_y(y)-mark_y,
  259.                get_phys_x(x)       ,get_phys_y(y)+mark_y,yellow);
  260.           draw(get_phys_x(x)+mark_x,get_phys_y(y)-mark_y,
  261.                get_phys_x(x)       ,get_phys_y(y)+mark_y,yellow);
  262.           draw(get_phys_x(x)+mark_x,get_phys_y(y)-mark_y,
  263.                get_phys_x(x)-mark_x,get_phys_y(y)-mark_y,yellow);
  264.        end;
  265.    end;
  266. end;
  267.  
  268.  
  269.  
  270. (* ------------------------------------------------------------------- *)
  271. {place a label on the y axis}
  272.  
  273. procedure labely(y: real);
  274. var
  275.    s: string;
  276. begin
  277.    MoveTo(1,get_phys_y(y));
  278.    str(y:12:2,s);
  279.    OutText(s);
  280. end;
  281.  
  282.  
  283.  
  284. (* ------------------------------------------------------------------- *)
  285. {place a tick mark on the y axis}
  286.  
  287. procedure ticky(y: real);
  288. begin
  289.    draw(trunc(phys_minx-mark_x),get_phys_y(y),
  290.         trunc(phys_minx),       get_phys_y(y),color);
  291. end;
  292.  
  293.  
  294.  
  295. (* ------------------------------------------------------------------- *)
  296. {place a label on the x axis}
  297.  
  298. procedure labelx(x: real);
  299. var
  300.    s: string;
  301. begin
  302.    MoveTo(get_phys_x(x),trunc(phys_miny)+10);
  303.    str(x:0:2,s);
  304.    OutText(s);
  305. end;
  306.  
  307.  
  308.  
  309. (* ------------------------------------------------------------------- *)
  310. {place a tick mark on the x axis}
  311.  
  312. procedure tickx(x: real);
  313. begin
  314.    draw(get_phys_x(x),trunc(phys_miny-mark_y),
  315.         get_phys_x(x),trunc(phys_miny),color);
  316. end;
  317.  
  318.  
  319.  
  320. (* ------------------------------------------------------------------- *)
  321. {output the x axis scales}
  322.  
  323. procedure putxscale;
  324. var
  325.    i,j:    integer;
  326.    y:      real;
  327.    x:      real;
  328.    px,py:  integer;
  329.  
  330. begin
  331.    x := minx;
  332.    for i := 1 to nxsteps do
  333.    begin
  334.       labelx(x);
  335.       px := get_phys_x(x);
  336.  
  337.       y := miny;
  338.       for j := 1 to numtics*nysteps do
  339.       begin
  340.          py := get_phys_y(y);
  341.          draw(px,py,px,py,color);
  342.          y := y + ystep/numtics;
  343.       end;
  344.  
  345.       for j := 1 to numtics do
  346.       begin
  347.          tickx(x);
  348.          x := x + xstep/numtics;
  349.       end;
  350.    end;
  351. end;
  352.  
  353.  
  354.  
  355. (* ------------------------------------------------------------------- *)
  356. {output the y axis scales}
  357.  
  358. procedure putyscale;
  359. var
  360.    i,j:  integer;
  361.    y:    real;
  362.  
  363. begin
  364.    y := miny;
  365.  
  366.    for i := 1 to nysteps do
  367.    begin
  368.       labely(y);
  369.       connect(minx,y,maxx,y);
  370.  
  371.       for j := 1 to numtics do
  372.       begin
  373.          ticky(y);
  374.          y := y + ystep / numtics;
  375.       end;
  376.    end;
  377. end;
  378.  
  379.  
  380.  
  381. (* ------------------------------------------------------------------- *)
  382. {output the border and scales for the graph}
  383.  
  384. procedure border;
  385. begin
  386.    determinescale(minx,maxx,xstep,nxsteps,6);
  387.    determinescale(miny,maxy,ystep,nysteps,6);
  388.  
  389.    color := green;
  390.    putxscale;
  391.    putyscale;
  392.  
  393.    color := red;
  394. end;
  395.  
  396.  
  397.  
  398. (* ------------------------------------------------------------------- *)
  399. procedure plot_data(variable_number: integer;
  400.                     x:               integer;
  401.                     y:               real);
  402. begin
  403.    tick(int(x),y);
  404.  
  405.    if (x mod 40) = 0 then
  406.       marker(int(x),y,variable_number);
  407. end;
  408.  
  409.  
  410. (* ------------------------------------------------------------------- *)
  411. procedure event(x: integer; note: string);
  412. begin
  413.    connect(int(x),miny,int(x),maxy);
  414.    {writeln(note);}
  415. end;
  416.  
  417.  
  418. (* ------------------------------------------------------------------- *)
  419. procedure open_graph;
  420. begin
  421.    Text_Mode := LastMode;
  422.    Graph_Driver := detect;
  423.    InitGraph(Graph_Driver,Graph_Mode,Driver_Path);
  424.  
  425.    phys_maxx := GetMaxX;
  426.    phys_minx := trunc(int(GetMaxX)/6.2);
  427.  
  428.    phys_miny := trunc(int(GetMaxY)*154.0/200.0);
  429.    phys_maxy := phys_miny div 5;
  430. end;
  431.  
  432.  
  433.  
  434. (* ------------------------------------------------------------------- *)
  435. procedure close_graph;
  436. begin
  437.    CloseGraph;
  438.    TextMode(Text_Mode);
  439.    window(1,1,80,25);
  440. end;
  441.  
  442.